procedure TForm1.Button1Click(Sender: T);

const CLAVE =
  "\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall";

var
  reg    : TRegistry;
  Lista  : TStringList;
  Lista2 : TStringList;
  i,n    : integer;

begin
 {Create temporal things}
  reg    := TRegistry.Create;
  Lista  := TStringList.Create;
  Lista2 := TStringList.Create;

  {Load all the subkeys}
 with Reg do
 begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(CLAVE,false);
    GetKeyNames(Lista);
  end;

  {Load all the Value Names}
 for i := 0 to Lista.Count -1 do begin
    reg.OpenKey(CLAVE + "\" +Lista.Strings[i],false);
    reg.GetValueNames(Lista2);

    {We will show only if there is "DisplayName"}
    n:=Lista2.IndexOf("DisplayName");
    if (n <> -1) and (Lista2.IndexOf("UninstallString")<>-1) then
 begin
 {DisplayName+UnInstallString}
      Memo1.Lines.Append ( reg.ReadString(Lista2.Strings[n])+"-"+
        reg.ReadString(Lista2.Strings[Lista2.IndexOf("UninstallString")]) );
    end;
  end;
  {Free temporals}
  Lista.Free;
  Lista2.Free;
  reg.CloseKey;
  reg.Destroy;
end;

Speed test